home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / alpha / examples / ConnectExample.d < prev    next >
Encoding:
Text File  |  2002-10-28  |  5.6 KB  |  160 lines
  1. /* Reaction Inter-Connection Notification Example
  2.    Ported to D by DMX
  3. */
  4.  
  5. MODULE 'exec/nodes','intuition','graphics','intuition/intuition','lib/amiga',
  6.        'intuition/gadgetclass','intuition/imageclass',
  7.        'intuition/intuitionbase','intuition/classusr',
  8.        'intuition/gadgetclass','intuition/cghooks','intuition/icclass',
  9.        'intuition/classes'
  10.  
  11. MODULE 'libraries/gadtools','intuition/icclass','dos','dos/dos',
  12.        'graphics','intuition','intuition/intuition','utility/tagitem'
  13.  
  14. MODULE 'window','classes/window','layout','gadgets/layout','gadgets/palette',
  15.        'gadgets/button','images/bevel','palette','images/label','label',
  16.        'classes/window','reaction/reaction_macros','button','reaction/reaction'
  17.  
  18. DEF ButtonBase:PTR TO ClassLibrary,LabelBase:PTR TO ClassLibrary,PaletteBase:PTR TO ClassLibrary
  19. DEF LayoutBase:PTR TO ClassLibrary,WindowBase:PTR TO ClassLibrary
  20.  
  21.  
  22. CONST ID_BUTTON=1,ID_FOREGROUND=2,ID_BACKGROUND=3
  23.  
  24. PROC main()
  25.  
  26. DEF window:PTR TO Window,
  27.     but_object:PTR TO Object,
  28.     win_object:PTR TO Object,
  29.     mapfg2button, mapbg2button,
  30.     tmpres1,tmpres2
  31. DEF wait, signal, result, done=FALSE, code
  32.  
  33.    mapfg2button := [PALETTE_Color, BUTTON_TextPen, TAG_END]
  34.    mapbg2button := [PALETTE_Color, BUTTON_BackgroundPen, TAG_END]
  35.  
  36.    WindowBase  := OpenLibrary('window.class',0)
  37.    LayoutBase  := OpenLibrary('gadgets/layout.gadget',0)
  38.    ButtonBase  := OpenLibrary('gadgets/button.gadget',0)
  39.    PaletteBase := OpenLibrary('gadgets/palette.gadget',0)
  40.    LabelBase   := OpenLibrary('images/label.image',0)
  41.  
  42.    IF (WindowBase AND LayoutBase AND ButtonBase AND PaletteBase AND LabelBase)
  43.  
  44. -> Create the window object.
  45.  
  46.       win_object := WindowObject,
  47.                         WA_ScreenTitle, 'Interconnect',
  48.                         WA_Title, 'Reaction Example',
  49.                         WA_SizeGadget, TRUE,
  50.                         WA_Left, 40,
  51.                         WA_Top, 30,
  52.                         WA_DepthGadget, TRUE,
  53.                         WA_DragBar, TRUE,
  54.                         WA_CloseGadget, TRUE,
  55.                         WA_Activate, TRUE,
  56.                         WA_SmartRefresh, TRUE,
  57.  
  58.                         WINDOW_ParentGroup, VLayoutObject,
  59.                            LAYOUT_SpaceOuter, TRUE,
  60.                            LAYOUT_DeferLayout, TRUE,
  61.                            LAYOUT_BevelStyle, GroupFrame,
  62.                            LAYOUT_Label, 'InterConnection',
  63.  
  64.                            StartMember, but_object := ButtonObject,
  65.                               GA_Text, '_Inter-Connection Example',
  66.                               GA_ID, ID_BUTTON,
  67.                            EndMember,
  68.                            CHILD_WeightedHeight, 0,
  69.  
  70.                            StartMember, HLayoutObject,
  71.                               LAYOUT_SpaceOuter, FALSE,
  72.  
  73.                               StartMember, PaletteObject,
  74.                                  GA_ID, ID_FOREGROUND,
  75.                                  PALETTE_NumColors, 8,
  76.                                  PALETTE_Color, 1,
  77.                                  ICA_TARGET, but_object, /* object to connect to */
  78.                                  ICA_MAP, mapfg2button, /* tag mapping array */
  79.                               EndMember,
  80.                               CHILD_Label, LabelObject, LABEL_Text, '_ForeGround', LabelEnd,
  81.                               CHILD_MinWidth, 90,
  82.                               CHILD_MinHeight, 20,
  83.  
  84.                               StartMember, PaletteObject,
  85.                                  GA_ID, ID_BACKGROUND,
  86.                                  PALETTE_NumColors, 8,
  87.                                  PALETTE_Color, 0,
  88.                                  ICA_TARGET, but_object, /* object to connect to */
  89.                                  ICA_MAP, mapbg2button, /* tag mapping array */
  90.                              EndMember,
  91.                              CHILD_Label, LabelObject,  LABEL_Text, '_BackGround', LabelEnd,
  92.                              CHILD_MinWidth, 90,
  93.                              CHILD_MinHeight, 20,
  94.                           EndMember,
  95.                        EndMember,
  96.                     EndWindow
  97.  
  98. -> Object creation sucessful?
  99.  
  100.       IF win_object
  101.  
  102. -> Open the window.
  103.  
  104.          IF (window := RA_OpenWindow(win_object))
  105.  
  106. -> Obtain the window wait signal mask.
  107.  
  108.             GetAttr(WINDOW_SigMask, win_object, &signal)
  109.  
  110. -> Input Event Loop
  111.  
  112.             WHILE (done = FALSE)
  113.                wait := Wait(signal OR SIGBREAKF_CTRL_C)
  114.                     
  115.                IF (wait AND SIGBREAKF_CTRL_C)
  116.                   done := TRUE
  117.  
  118.                ELSE
  119.  
  120.                   WHILE ((result := RA_HandleInput(win_object,&code)) <> WMHI_LASTMSG)
  121.  
  122.                      tmpres1 := (result AND WMHI_CLASSMASK)
  123.  
  124.                      SELECT tmpres1
  125.  
  126.                         CASE WMHI_CLOSEWINDOW ; done := TRUE
  127.  
  128.                         CASE WMHI_GADGETUP
  129.                            tmpres2 := (result AND WMHI_GADGETMASK)
  130.  
  131.                            SELECT tmpres2
  132.                              CASE ID_BUTTON //; NOP
  133.                            ENDSELECT
  134.  
  135.                      ENDSELECT
  136.  
  137.                   ENDWHILE
  138.                ENDIF
  139.             ENDWHILE
  140.          ENDIF
  141.  
  142.          /* Disposing of the window object will
  143.           * also close the window if it is
  144.           * already opened and it will dispose of
  145.           * all objects attached to it.
  146.           */
  147.         DisposeObject(win_object )
  148.       ENDIF
  149.    ENDIF
  150.  
  151. -> Close the classes.
  152.  
  153.    IF LabelBase   THEN CloseLibrary(LabelBase)
  154.    IF PaletteBase THEN CloseLibrary(PaletteBase)
  155.    IF ButtonBase  THEN CloseLibrary(ButtonBase)
  156.    IF LayoutBase  THEN CloseLibrary(LayoutBase)
  157.    IF WindowBase  THEN CloseLibrary(WindowBase)
  158.  
  159. ENDPROC
  160.